These are recent notes that are not intended to be comprehensive.
library(geneorama)
## Install xclip first:
"$ sudo apt-get install xclip"
# Install from CRAN
install.packages("clipr")
# Or try the development version
devtools::install_github("mdlincoln/clipr")
# library("clipr")
cb <- clipr::read_clip()
cb <- write_clip(c("Text", "for", "clipboard"))
cb <- write_clip(c("Text", "for", "clipboard"), breaks = ", ")
## Future use in geneorama?
## Nice fread example
con <- pipe("xclip -o -selection clipboard")
content <- scan(con, what = character(), sep = "\n", blank.lines.skip = FALSE, quiet = TRUE)
fread(paste(content, collapse = "\n"))
close(con)
This isn’t R, but it’s amazing. Use this code to record your screen in Linux. Source: http://www.commandlinefu.com/commands/browse
"ffmpeg -f x11grab -r 25 -s 800x600 -i :0.0 /tmp/outputFile.mpg"
# source:
# http://menugget.blogspot.com/2012/04/adding-transparent-image-layer-to-plot.html
add_alpha <- function(COLORS, ALPHA){
if(missing(ALPHA)) stop("provide a value for alpha between 0 and 1")
RGB <- col2rgb(COLORS, alpha=TRUE)
RGB[4,] <- round(RGB[4,]*ALPHA)
NEW.COLORS <- rgb(RGB[1,], RGB[2,], RGB[3,], RGB[4,], maxColorValue = 255)
return(NEW.COLORS)
}
cols <- c('transparent','blue','yellow','red','darkred')
colramp <- colorRampPalette(add_alpha(cols, .5), alpha=T)
df <- data.table(x=rnorm(100), y=rnorm(100))
df[ , plot(x,y)]
## NULL
df[ , smoothScatter(x,y,colramp = colramp, add=TRUE,
nbin = c(300, 300), bandwidth = c(.2, .2),
transformation=function(x) sqrt(x))]
## NULL
library(ggmap)
## Loading required package: ggplot2
set_project_dir("geneorama")
infile <- "doc/ggmap_chicago.Rds"
## LOAD DATA
## Also, clean up variable names, and convert dates
if(!file.exists(infile)){
mapdata <- get_map("Chicago, Illinois", zoom=10)
saveRDS(mapdata, infile)
}
mapdata <- readRDS(infile)
ggmap(mapdata)
str(mapdata)
## chr [1:1280, 1:1280] "#EAE7E0" "#E7E6DE" "#F1EFEC" "#F4F1EF" ...
## - attr(*, "class")= chr [1:2] "ggmap" "raster"
## - attr(*, "bb")='data.frame': 1 obs. of 4 variables:
## ..$ ll.lat: num 41.5
## ..$ ll.lon: num -88.1
## ..$ ur.lat: num 42.2
## ..$ ur.lon: num -87.2
## - attr(*, "source")= chr "google"
## - attr(*, "maptype")= chr "terrain"
## - attr(*, "zoom")= num 10
# saveRDS(mapdata, "ggmap_data.Rds")
library()
## Warning in library(): libraries '/usr/local/lib/R/site-library', '/usr/lib/
## R/site-library' contain no packages
pal <- leaflet::colorQuantile("Greens", NULL, n = 6)
pal <- leaflet::colorNumeric('PuBuGn', 10)
df <- data.table(x=rnorm(1000), y=rnorm(1000))
vals <- df[,1/(3+(x+y)^2)]
pal <- leaflet::colorNumeric('PuBuGn', range(vals))
df[ , plot(y~x, pch=19, col=pal(vals), cex=5)]
## NULL
RColorBrewer::display.brewer.all(colorblindFriendly=TRUE)
RColorBrewer::brewer.pal.info
## maxcolors category colorblind
## BrBG 11 div TRUE
## PiYG 11 div TRUE
## PRGn 11 div TRUE
## PuOr 11 div TRUE
## RdBu 11 div TRUE
## RdGy 11 div FALSE
## RdYlBu 11 div TRUE
## RdYlGn 11 div FALSE
## Spectral 11 div FALSE
## Accent 8 qual FALSE
## Dark2 8 qual TRUE
## Paired 12 qual TRUE
## Pastel1 9 qual FALSE
## Pastel2 8 qual FALSE
## Set1 9 qual FALSE
## Set2 8 qual TRUE
## Set3 12 qual FALSE
## Blues 9 seq TRUE
## BuGn 9 seq TRUE
## BuPu 9 seq TRUE
## GnBu 9 seq TRUE
## Greens 9 seq TRUE
## Greys 9 seq TRUE
## Oranges 9 seq TRUE
## OrRd 9 seq TRUE
## PuBu 9 seq TRUE
## PuBuGn 9 seq TRUE
## PuRd 9 seq TRUE
## Purples 9 seq TRUE
## RdPu 9 seq TRUE
## Reds 9 seq TRUE
## YlGn 9 seq TRUE
## YlGnBu 9 seq TRUE
## YlOrBr 9 seq TRUE
## YlOrRd 9 seq TRUE
Modified to use RCurl and adding elements from example from food-inspections-model (recent branch)
set_project_dir("geneorama")
## INITIALIZE
loadinstall_libraries(c("leaflet", "data.table", "sp", "rgdal", "KernSmooth", "RCurl"))
##
## Loading required libraries:
## Attaching: leaflet
## Attaching: data.table
## Attaching: sp
## Attaching: rgdal
## rgdal: version: 1.1-10, (SVN revision 622)
## Geospatial Data Abstraction Library extensions to R successfully loaded
## Loaded GDAL runtime: GDAL 1.11.3, released 2015/09/16
## Path to GDAL shared files: /usr/share/gdal/1.11
## Loaded PROJ.4 runtime: Rel. 4.9.2, 08 September 2015, [PJ_VERSION: 492]
## Path to PROJ.4 shared files: (autodetected)
## Linking to sp version: 1.2-3
## Attaching: KernSmooth
## KernSmooth 2.23 loaded
## Copyright M. P. Wand 1997-2009
## Attaching: RCurl
# library("maptools")
inurl <- "https://data.cityofchicago.org/api/views/22s8-eq8h/rows.csv?accessType=DOWNLOAD"
infile <- "doc/mvthefts.Rds"
## LOAD DATA
## Also, clean up variable names, and convert dates
if(!file.exists(infile)){
# download.file(url = inurl, destfile = infile)
dat <- fread(RCurl::httpGET(inurl)[1])
setnames(dat, tolower(colnames(dat)))
setnames(dat, gsub(" ", "_", colnames(dat)))
dat <- dat[!is.na(longitude)]
dat[ , date := as.IDate(date, "%m/%d/%Y")]
saveRDS(dat, infile)
}
dat <- readRDS(infile)
## MAKE CONTOUR LINES
## Note, bandwidth choice is based on MASS::bandwidth.nrd()
kde <- bkde2D(dat[ , list(longitude, latitude)],
bandwidth=c(.0045, .0068), gridsize = c(100,100))
CL <- contourLines(kde$x1 , kde$x2 , kde$fhat)
## EXTRACT CONTOUR LINE LEVELS
LEVS <- as.factor(sapply(CL, `[[`, "level"))
NLEV <- length(levels(LEVS))
## CONVERT CONTOUR LINES TO POLYGONS
pgons <- lapply(1:length(CL), function(i)
Polygons(list(Polygon(cbind(CL[[i]]$x, CL[[i]]$y))), ID=i))
spgons = SpatialPolygons(pgons)
## MAPBOX INFO
MAPBOX_STYLE_TEMPLATE <- paste0("https://api.mapbox.com/styles/v1/coc375492/",
"cirqd7mgf001ygcnombg4jtb4/tiles/256/{z}/{x}/{y}",
"?access_token=pk.eyJ1IjoiY29jMzc1NDkyIiwiYSI6ImN",
"pcnBldzVqMTBmc3J0N25rZTIxZ3ludDIifQ.DgJIcLDjC1h9MtT8CaJ-pQ")
mb_attribution <- paste("© <a href='https://www.mapbox.com/about/maps/'>Mapbox</a> ",
"© <a href='http://www.openstreetmap.org/about/'>OpenStreetMap</a>")
## Leaflet map with points and polygons
## Note, this shows some problems with the KDE, in my opinion...
## For example there seems to be a hot spot at the intersection of Mayfield and
## Fillmore, but it's not getting picked up. Maybe a smaller bw is a good idea?
dat[ , LABEL := paste0(date, " | ", location_description, " | arrest:", arrest)]
# pal <- leaflet::colorQuantile("Greens", NULL, n = NLEV)
pal <- leaflet::colorFactor("Greens", NULL, levels = NLEV)
pal <- leaflet::colorFactor("Greens", levels = -NLEV:NLEV)
# pal <- leaflet::colorNumeric('PuBuGn', -5:NLEV)
# pal <- leaflet::colorNumeric('PuOr', NLEV:-1)
leaflet(spgons) %>%
# addProviderTiles("CartoDB.Positron") %>%
addTiles(urlTemplate = MAPBOX_STYLE_TEMPLATE, attribution = mb_attribution) %>%
# addPolygons(color = heat.colors(NLEV, NULL)[LEVS], weight=1, fillOpacity=.25) %>%
addPolygons(color = pal(as.numeric(LEVS)), weight=1, fillOpacity=.25) %>%
addCircles(lng = ~longitude, lat = ~latitude, weight = 3, popup = ~LABEL,
data = dat, radius = .5, opacity = .4,
col = ifelse(dat$arrest=="true", "yellow", "red")) %>%
addLegend(pal = pal,
values = LEVS,
position = "bottomright",
title = "Crime Intensity") %>%
addLegend(colors = c("yellow", "red"),
labels = c("true", "false"),
position = "bottomleft",
title = "Arrest")
## Uncomment to save results
# library(maptools)
# spdf <- SpatialPolygonsDataFrame(spgons, as.data.frame(LEVS), match.ID = F)
# dircreate("mapdata")
# writePolyShape(spdf, "mapdata/any_name")
geneorama::loadinstall_libraries(c("geneorama", "ggmap", "ggplot2"))
##
## Loading required libraries:
## Attaching: geneorama
## Attaching: ggmap
## Attaching: ggplot2
set_project_dir("geneorama")
infile <- "doc/ggmap_chicago.Rds"
## LOAD MAP DATA
## Also, clean up variable names, and convert dates
if(!file.exists(infile)){
mapdata <- get_map("Chicago, Illinois", zoom=10)
saveRDS(mapdata, infile)
}
mapdata <- readRDS(infile)
## LOAD CRIME DATA
inurl <- "https://data.cityofchicago.org/api/views/22s8-eq8h/rows.csv?accessType=DOWNLOAD"
infile <- "doc/mvthefts.Rds"
## LOAD DATA
## Also, clean up variable names, and convert dates
if(!file.exists(infile)){
# download.file(url = inurl, destfile = infile)
dat <- fread(RCurl::httpGET(inurl)[1])
setnames(dat, tolower(colnames(dat)))
setnames(dat, gsub(" ", "_", colnames(dat)))
dat <- dat[!is.na(longitude)]
dat[ , date := as.IDate(date, "%m/%d/%Y")]
saveRDS(dat, infile)
}
dat <- readRDS(infile)
## Crime points
cpts <- dat[,list(lon=longitude, lat=latitude)]
## Density plot (built into ggplot)
base_plot <- ggmap(mapdata)
base_plot + stat_density2d(data=cpts, aes(group=1), color = 4)
## Contour lines - Build kernel density
rng <- unname(unlist(cpts[ , list(range(lon), range(lat))]))
cdens <- MASS::kde2d(x = cpts$lon, y = cpts$lat, h = .03, n = 100, lims = rng)
cdens_dt <- data.table(z=melt(cdens$z))
setnames(cdens_dt, c("x", "y", "z"))
cdens_dt[ , x:=cdens$x[cdens_dt$x]]
cdens_dt[ , y:=cdens$y[cdens_dt$y]]
cdens_dt
## x y z
## 1: -87.90646 41.64820 1.559735e-109
## 2: -87.90261 41.64820 2.646971e-106
## 3: -87.89875 41.64820 3.450761e-103
## 4: -87.89489 41.64820 3.455719e-100
## 5: -87.89104 41.64820 2.658338e-97
## ---
## 9996: -87.54008 42.02253 3.729963e-51
## 9997: -87.53622 42.02253 4.408004e-54
## 9998: -87.53237 42.02253 4.026018e-57
## 9999: -87.52851 42.02253 2.838198e-60
## 10000: -87.52465 42.02253 1.542649e-63
## Contour lines - Plot without base layer (proof of concept)
ggplot(data = cdens_dt, aes(x,y,z=z)) + stat_contour(aes(x,y,z=z))
## Contour lines
base_plot + stat_contour(data = cdens_dt, aes(x,y,z=z, group=1))
base_plot + stat_contour(data = cdens_dt, aes(x,y,z=z, group=1)) +
annotate("text", x = -87.825, y = 41.73, label=paste0("Chicago"), size=8)
base_plot + stat_contour(data = cdens_dt,
aes(x,y,z=z, group=1, colour = ..level..), size=1)
base_plot +
stat_contour(data = cdens_dt, geom="polygon", alpha=.2,
aes(x,y,z=z, group=1, fill = ..level..)) +
annotate("text", x = -87.825, y = 41.73,
label=paste0("Burglary density\nin 2013"), size=7)